COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	CFORS3     FORTRAN UNIT GENERATOR ROUTINE   *** MUSIC V ***     
C00011 ENDMK
C⊗;
CFORS3     FORTRAN UNIT GENERATOR ROUTINE   *** MUSIC V ***     
      SUBROUTINE FORSAM   
	DIMENSION ENVP(27),COSP(27),IEN(100),KEN(100),BUSY(27)
C COSP & ENVP STORE POINTERS FOR 'COS' & 'ENV' ARRAYS. SEE AT 105 FOR INFO.
	COMMON /LM/L(10),M(10),NSAMX
C CAN USE UP TO 10 FIELDS IN UNIT GEN.
      COMMON I(1) /P/P(1) /GENS/GENS(1) /LFUNC/LFUNC,XNFUN,PINCR
	1 /XIN/AMP,FREQ
	COMMON /INS/INS(1) /NT/RNT(1) /ROUT/ROUT(1) /JJJ/JJJ(30)
C  INS=INSTRUMENT DEFINITIONS, RNT=NOTE CARD INFO, ROUT=OUTPUT BLOCK
	INTEGER PTICK,HTICK,SETUP(8)
	1,DECAY,SWEEP,DEXP,GSETUP(8),KKK(100),MODE(4)
	DATA PTICK/"137/,HTICK/"206/,TICKTIM/.000000195/,IFLIP/1/,
	1 SETUP/"44000,"7641005000,0,   "2400,"3000,
	1 "5400,"1000,"3400/,KCNT/3/,SCALE/8388608.0/,IMAX/16777216/
	1,INEG/"3777777/
	DATA MODE/"1210027400,"20000047600,"10000006400,
	1 "6200/

      EQUIVALENCE(M1,M(1)),(M2,M(2)),(M3,M(3)),(M4,M(4)),(M5,M(5)),(M6,M
     1(6)),(M7,M(7)),(M8,M(8)),(L1,L(1)),(L2,L(2)),(L3,L(3)),(L4,L(4)),(  
     2 L5,L(5)),(L6,L(6)),(L7,L(7)),(L8,L(8)),(AMP,XIN1),(FREQ,XIN2)
	3 ,(I5,I(5)),(I6,I(6)),(I3,I(3)),(L9,L(9)),(KKK,GSETUP)
C NOW GET SRATE
	KGEN=0
C FIRST AVAILABLE GEN. NUM.
	SRATE=1.0/((HTICK+2)*TICKTIM)
	RMAG=1048576.0/SRATE
9999	IF(IFLIP.LT.0)GO TO 9998
	IFLIP=-IFLIP
	KCNT=KCNT+1
9998	CALL INITIT(J3)
  	AMP=RNT(L1)      
   	FREQ=RNT(L2)     
C            OUT OSC AD2 RAI ENV STR AD3 AD4 MLT DIV RAH 
      GO TO (101,102,103,104,105,106,107,108,109,110,111,112,113,114,
	1 115,116,117,118),J3     
114     CALL OPT(L,M,NSAM)
112	RETURN
113	CALL REVERB
C ADD REVERB SUBROUTINE ONLY WHEN WANTED.  IT NEEDS EXTRA MEMORY.
117	RETURN
C 117 WILL BE FOR 'INP', READING EXTERNAL SOUND FILES.

C     UNIT GENERATORS    
C     OUTPUT BOX  
101	IFLIP=-IFLIP
	P1=RNT(L2+1)
C BEGIN TIME OF THIS NOTE
	P2=RNT(L2+3)+P1
C END TIME OF THIS NOTE.
	DO 1 K=1,27
C RESET BUSY ARRAY
1	IF(BUSY(K).LE.P2)BUSY(K)=0
 	DO 2 K=1,27
	IF(BUSY(K).NE.0)GO TO 2
	BUSY(K)=P2
C SAVE END TIME OF THIS NOTE
	KGEN=K+3
	GO TO 3
2	CONTINUE
3	DO 2101 K=1,8
2101	GSETUP(K)=SETUP(K)+KGEN
	GSETUP(3)=JFREQ
	GSETUP(4)=GSETUP(4)+IFREQ
	DO 4101 K=1,4
4101	KEN(K)=MODE(K)+KGEN
	KEN(5)=GSETUP(7)
	JY=5
	J1=1
	KENV=KENV+4
	KEN(JY-1)=IEN(1)*4096+272
3101	JY=JY+2           
	J1=J1+2
	KEN(JY)=IEN(J1-1)*4096+SETUP(5)+KGEN
	KEN(JY+1)=IEN(J1)*4096+272
C 272="420
	IF(JY.LT.KENV)GO TO 3101
	J1=0
	JY=JY+3
	KEN(JY-1)=GSETUP(5)
	KEN(JY)=GSETUP(7)
6101	JB=0
	J1=JY+9
	KKK(J1)=0
	DO 5101 K=9,JY+9
	JB=JB+1
5101	KKK(K)=KEN(JB)
	CALL SAMO2(KKK,J1)
C WRITES SAM HEADER+DATA
CC	PAUSE
      RETURN
1101	FORMAT(4O)
C OUTPUT=WHAT'S THERE ALREADY + WHAT'S COMING IN FROM THIS INST.
C  THIS NEW FORM ASSUMES THE OUT BOX HAS ONLY 'Bn' AS INPUT.

C     OSCILLATOR    L1,L2 = P or B   L3=B   L4=F or P   L5=P
C			AMPL, TIME, OUTPUT,  FUNC,    5TH NO LONGER USED.
C M1, M2 =1 = NT.  =0 = ROUT  (P=FIXED INPUT, B=DYNAMIC INPUT, F=FUNC.)
 102	  CALL LOCGEN(M4,L4)
C  FINDS POINTER TO FUNC NUM.  IF M4.EQ.1 THEN FNUM WAS IN INST DEF. 
	IF(GENS(L4).EQ.999.0)GO TO 1118
C JUMP IF USING SEG FUNC.
CC	IFREQ=FREQ*RMAG
	RFREQ=FREQ*RMAG
	IFREQ=RFREQ
	RFREQ=RFREQ-IFREQ
	IFREQ=IFREQ*4096
	JFREQ=0
292	JFREQ=RFREQ*256.
CC	JFREQ=JFREQ*9388608+32
	JFREQ=JFREQ*16777216+32
 293  CONTINUE    
      RETURN      

C     ENV  ****TEMPORARY****    L1,L2 = P or B   L3=B   L4=F or P   L5=P
C			AMPL, TIME, OUTPUT,  FUNC,    5TH NO LONGER USED.
C M1, M2 =1 = NT.  =0 = ROUT  (P=FIXED INPUT, B=DYNAMIC INPUT, F=FUNC.)
1118	KENV=-1
	X=0
	Y=P(4)*SRATE
C P(4)=NOTE DUR.
	JB=RNT(L2-2)*SRATE
C THIS IS "P1"  BEGIN TIME OF THIS NOTE.
CC	IF(JB.EQ.0)GO TO 2118
	KENV=0
	IEN(1)=JB
2118	L4=L4+2
	IF(GENS(L4-1).EQ.999.)GO TO 3118
C 999=END OF FUNC.
	KENV=KENV+2
	JY=(GENS(L4)-X)*Y
	X=GENS(L4)
	JB=JB+JY
	IEN(KENV+1)=JB
C LINGER  
	JY=(SCALE*GENS(L4-1))/JY
	IF(JY.LT.0)JY=JY.AND.INEG
C AMPL. INCREMENT
	IEN(KENV)=JY
	GO TO 2118
C KENV+1 IS WORD COUNT FOR ENV.
3118	KENV=KENV+1
	IEN(KENV+1)=JB+3
C +3 FOR TERMINATION OF NOTE ?????
C THIS DOESN'T SEEM TO BE NEEDED.
    	RETURN

C     ADD TWO BOX 
C LOOK AT NT ARRAY FOR FIXED VALUES, LOOK AT ROUT FOR CHANGING VALS.
CC103      DO 258 J3=0,NSAMX    
CC	IF(M1.GT.0)XIN1=ROUT(J3+L1)
CC    	IF(M2.GT.0)XIN2=ROUT(L2+J3)
CC      ROUT(J3+L3)=XIN1+XIN2      
CC 258  CONTINUE    
103	CALL AD2
C CALLS FAIL VERSION
      RETURN      

C 116  SUBTRACT
116	CALL SUB
C CALLS FAIL VERSION
	RETURN


C     STEREO OUTPUT BOX  L1,L2 = B       L3=B1
C IT IS ASSUMED ALL INPUTS ARE 'B' TYPE.
106   NSSAM=2*NSAM       
C  6/29/70  L.C.SMITH
      ICT=0
      DO 206 J3=1,NSSAM,2  
      J4=L1+ICT
      XIN1=ROUT(J4)  
 306  J5=L3+J3-1 
      ROUT(J5)=XIN1+ROUT(J5)    
506   J4=L2+ICT
      XIN2=ROUT(J4)  
 406  J5=L3+J3   
      ROUT(J5)=XIN2+ROUT(J5)    
 206  ICT=ICT+1  
      RETURN     


C     MULTIPLIER 
109	CALL MLT
C CALLS FAIL VERSION
	RETURN

C 110 DIVIDER
110	CALL DIV
C CALLS FAIL VERSION
	RETURN


      END

	SUBROUTINE RNDM(X)
	X=2.*RAN(X)-1.
C SENDS BACK NUMBER BETWEEN -1 AND +1
	END

	SUBROUTINE LOCGEN(M,L)
	COMMON /NT/RNT(1) /LOCG/LOCG(1)
	IF(M.EQ.0)L=LOCG(INT(RNT(L)))
C GET POINTER TO START OF FUNC. ARRAY
	END